// System Unit
// Threading Support

(*************)
(* Interface *)
(*************)
{$IFDEF Include_Modules_Header}

 // These fields should be immutable
 Function ThreadCount: Cardinal;
 Function MainThreadID: Cardinal;

 Type
  TThreadFunc = Function(Parameter: Pointer): Cardinal;

 // Note: In order for the RTL to function properly, all Delphi threads should be started and ended using the following functions
 Function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord; ThreadFunc: TThreadFunc; Parameter: Pointer;
                      CreationFlags: LongWord; Var ThreadID: Cardinal): Cardinal;
 Procedure EndThread(ExitCode: Cardinal);

{$ENDIF Include_Modules_Header}
(******************)
(* Implementation *)
(******************)
{$IFDEF Include_Modules_Implement}

 Var
  _INT_ThreadCount: Cardinal = 0;  // Total number of threads
  _INT_MainThreadID: Cardinal = 0; // Application main thread ID

 Function ThreadCount: Cardinal;
  BEGIN
   Result:= _INT_ThreadCount;
  END;

 Function MainThreadID: Cardinal;
  BEGIN
   Result:= _INT_MainThreadID;
  END;

 Procedure _INT_InterlockedIncrement(Var Addend: Cardinal);
  ASM
   LOCK INC [AddEnd]
  END;

 Procedure _INT_InterlockedDecrement(Var Addend: Cardinal);
  ASM
   LOCK DEC [Addend]
  END;

 Type
  _INT_PThreadRec = ^_INT_TThreadRec;
  _INT_TThreadRec = Record
   Func: TThreadFunc;
   Parameter: Pointer;
  END;

 Function _INT_ThreadWrapper(Parameter: Pointer): Cardinal; StdCall;
  Var ThreadRec: _INT_TThreadRec;
  BEGIN
   _INT_FPUInit;
   Try
    ThreadRec:= _INT_PThreadRec(Parameter)^;
    FreeMem(Parameter);

    With ThreadRec do
     Result:= Func(Parameter);
   Except
    Result:= RTL_ErrorToExitCode(_INT_RTLError.Error);
   END;
   _INT_InterlockedDecrement(_INT_ThreadCount);
  END;

 Function BeginThread(SecurityAttributes: Pointer; StackSize: LongWord; ThreadFunc: TThreadFunc; Parameter: Pointer;
                      CreationFlags: LongWord; Var ThreadID: Cardinal): Cardinal;
  Var PThreadRec: _INT_PThreadRec;
  BEGIN
   // Note: Supposed to be freed by the new thread
   New(PThreadRec);
   With PThreadRec^ do
    BEGIN
     Func:= ThreadFunc;
     Parameter:= Parameter;
    END;

   // Note: Supposed to be decremented when thread exit
   _INT_InterlockedIncrement(_INT_ThreadCount);

   Result:= _WIN_CreateThread(SecurityAttributes, StackSize, @_INT_ThreadWrapper, PThreadRec, CreationFlags, ThreadID);

   IF Result = 0 then
    BEGIN
     // If no thread is created, we have to cleanup
     Dispose(PThreadRec);
     _INT_InterlockedDecrement(_INT_ThreadCount);
    END;
  END;

 Procedure EndThread(ExitCode: Cardinal);
  BEGIN
   // Fool-proof
   IF _INT_MainThreadID = _WIN_GetCurrentThreadID
   then Halt(ExitCode);

   _INT_InterlockedDecrement(_INT_ThreadCount);
   _WIN_ExitThread(ExitCode);
  END;

{$ENDIF Include_Modules_Implement}
(******************)
(* Initialization *)
(******************)
{$IFDEF Include_Modules_Initialize}
{$ENDIF Include_Modules_Initialize}
(****************)
(* Finalization *)
(****************)
{$IFDEF Include_Modules_Finalize}
{$ENDIF Include_Modules_Finalize}
